home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / lalr.lha / lalr / src / Automaton.mi < prev    next >
Text File  |  1992-08-18  |  21KB  |  814 lines
  1. (* handle LR automaton *)
  2.  
  3. (* $Id: Automaton.mi,v 2.2 1992/08/07 15:22:49 grosch rel $ *)
  4.  
  5. (* $Log: Automaton.mi,v $
  6.  * Revision 2.2  1992/08/07  15:22:49  grosch
  7.  * allow several scanner and parsers; extend module Errors
  8.  *
  9.  * Revision 2.1  1991/11/21  14:53:14  grosch
  10.  * new version of RCS on SPARC
  11.  *
  12.  * Revision 2.0  91/03/08  18:31:33  grosch
  13.  * turned tables into initialized arrays (in C)
  14.  * moved mapping tokens -> strings from Errors to Parser
  15.  * changed interface for source position
  16.  * 
  17.  * Revision 1.4  90/09/20  17:52:34  grosch
  18.  * calmed down lint
  19.  * 
  20.  * Revision 1.3  90/09/10  16:25:43  grosch
  21.  * added automatic alignment for ProdArray
  22.  * 
  23.  * Revision 1.2  90/06/12  16:53:36  grosch
  24.  * renamed main program to lalr, added { } for actions, layout improvements
  25.  * 
  26.  * Revision 1.1     89/01/12  18:08:51  vielsack
  27.  * supply a line number for each action
  28.  * 
  29.  * Revision 1.0     88/10/04  14:35:50  vielsack
  30.  * Initial revision
  31.  * 
  32.  *)
  33.  
  34. IMPLEMENTATION MODULE Automaton;
  35.  
  36. FROM Continue    IMPORT Value, ValueNonterms;
  37. FROM DynArray    IMPORT MakeArray, ExtendArray;
  38. FROM Errors    IMPORT eFatal, eError, eWarning, eInformation, eIdent, eString,
  39.             eInternal, ErrorMessage, ErrorMessageI;
  40. FROM Lists    IMPORT MakeList, tList;
  41. FROM Oper    IMPORT OperKind, InitPrioReading, GetPriority, GetOperator;
  42. FROM Rules    IMPORT Operation, Expression, InitRulesReading, GetNodeOperation,
  43.             GetRule, GetBracketNode, GetUnaryNode, GetBinaryNode,
  44.             GetLeafNode, GetActionNode, NoExpression;
  45. FROM Sets    IMPORT MakeSet, ReleaseSet, AssignEmpty, Include, Extract,
  46.             IsEmpty, IsElement, ForallDo, tSet;
  47. FROM Strings    IMPORT tString, ArrayToString;
  48. FROM Idents    IMPORT tIdent, MakeIdent;
  49. FROM SYSTEM    IMPORT WORD, TSIZE, ADR;
  50. FROM General    IMPORT MaxAlign;
  51. FROM Positions    IMPORT NoPosition;
  52. FROM TokenTab    IMPORT EndOfToken, MAXTerm, MINNonTerm, MAXNonTerm, cMAXNonTerm,
  53.             PosType, TokenError, Prio, Terminal, NonTerminal, Vocabulary,
  54.             TokenToSymbol, MakeVoc;
  55.  
  56.   CONST
  57.     eNoBNF    = 60;
  58.     eActInside    = 61;
  59.  
  60.     InitProdCount  = 1000;  (* Anfangsplatzgroesse fuer Produktionen in WORD *)
  61.     InitItemCount  = 200;   (* Anfangsplatzgroesse fuer Items *)
  62.     InitStateCount = 50;    (* Anfangsplatzgroesse fuer States *)
  63.     InitListCount  = 4;        (* Anfangsplatzgroesse fuer ProdList *)
  64.     InitHashListCount = 4;  (* Anfangsplatzgroesse fuer HashList *)
  65.     InitStackCount = 10;    (* Anfangsplatzgroesse fuer ActionStack *)
  66.     InitRelationListCount = 10; (* Anfagsplatxgroesse fuer Relationlisten *)
  67.  
  68.   TYPE
  69.     HashIndex = [0..99];
  70.  
  71.     tDummyProduction =           (* vgl. tProduction in Def.-Module *)
  72.       RECORD
  73.     ProdNo    : tIndex;
  74.     Reduce    : tIndexList;
  75.     Act    : tList;
  76.     ActPos    : PosType;
  77.     Ass    : tAss;
  78.     Pri    : Prio;
  79.     Len    : tIndex;
  80.     Left    : NonTerminal;
  81.       END;
  82.     
  83.     tDummyRight4 = ARRAY [1..4] OF SHORTCARD [0..cMAXNonTerm];
  84.     
  85.     tStackElmt = RECORD
  86.     Act    : tList;
  87.     ActPos    : PosType;
  88.     Voc    : Vocabulary; 
  89.       END;
  90.  
  91.   VAR
  92.     ProdElmtCount  : LONGINT;         (* aktuelle Feldgroesse *)
  93.     Production       : tProduction;     (* Index akt. bzw. naechsten P.*)
  94.     ItemElmtCount  : LONGINT;         (* aktuelle Feldgroesse fuer I. *)
  95.     StateElmtCount : LONGINT;         (* aktuelle Feldgroesse fuer S. *)
  96.     StateHashList  : ARRAY         (* Hashtabelle fuer States    *)
  97.              HashIndex OF tIndexList;
  98.     StackArrayPtr  : POINTER TO ARRAY     (* Stack fuer nichtbearbeitete *)
  99.              [1..Infinite] OF tStackElmt; (* NonTerminale, Aktionen *)
  100.     StackElmtCount : LONGINT;         (* Stackgroesse *)
  101.     StackIndex       : LONGINT;         (* Index Top of Stack *)
  102.     
  103.     i          : CARDINAL;  (* Schleifenzaehler *)
  104.     prio      : CARDINAL;  (* Prioritaet der aktuellen Produktion
  105.                   fuer InsertProductions und InsertRight *)
  106.     NonTermNo : CARDINAL;
  107.     ProdSet   : tSet;
  108.  
  109. PROCEDURE InitAutomaton;
  110.  
  111.   (* Initialisiert den Automat, d.h. die zur Automatenkonstruktion
  112.      noetigen Daten werden vom Module Rules uebernommen *)
  113.  
  114.   BEGIN
  115.     IsBnf := TRUE;
  116.     InsertOperators;
  117.     InsertProductions;
  118.   END InitAutomaton;
  119.  
  120. PROCEDURE MakeFirstState (): tStateIndex;
  121.   VAR 
  122.     new : BOOLEAN;
  123.     pi : tProdIndex;
  124.     prod : tProduction;
  125.     read : Vocabulary;
  126.   BEGIN
  127.  
  128.     (* Bilde einen neun Zustand *)
  129.  
  130.     NextState;
  131.     INC (StateArrayPtr^[StateIndex].Size);
  132.  
  133.     pi := ProdList[StartSymbol].Array^[1].Index;
  134.     prod := ADR (ProdArrayPtr^[pi]);
  135.     read := prod^.Right [1];
  136.  
  137.     (* Beschaffe neues Item *)
  138.  
  139.     NextItem (read);
  140.  
  141.     (* Trage die Produktion mit dem neuen Startsymbol ein *)
  142.  
  143.     ItemArrayPtr^[ItemIndex].Prod := pi;
  144.     ItemArrayPtr^[ItemIndex].Pos  := 0;
  145.  
  146.     (* Hilfsmenge fuer Closure *)
  147.  
  148.     MakeSet (ProdSet, ProdCount);
  149.  
  150.     (* Bilde Huelle *)
  151.  
  152.     Closure (read);
  153.     RETURN UniqueState (new);
  154.   END MakeFirstState;
  155.  
  156. PROCEDURE GotoSet (Index: tStateIndex; VAR Set: tSet);
  157.   VAR
  158.     v  : Vocabulary;
  159.     i  : tItemIndex;
  160.     pr : tProdIndex;
  161.     po : tIndex;
  162.     p : tProduction;
  163.   BEGIN
  164.     AssignEmpty (Set);
  165.     WITH StateArrayPtr^[Index] DO      (* State *)
  166.       FOR i:= Items TO Items + Size - 1 DO
  167.  
  168.       (* Symbol nach dem Punkt ist zu bearbeiten *)
  169.  
  170.     v  := ItemArrayPtr^[i].Read;
  171.     IF (v <= MAXNonTerm) THEN   (* gibt es ein naechstes Symbol *)
  172.       Include (Set,v);        (* trage es ein *)
  173.     END;
  174.       END;
  175.     END;
  176.   END GotoSet;
  177.  
  178. PROCEDURE Goto (Index: tStateIndex; Symbol: Vocabulary; VAR new: BOOLEAN): tStateIndex;
  179.   VAR
  180.     p : tProduction;
  181.     i : tItemIndex;
  182.     pr: tProdIndex;
  183.     po: tIndex;
  184.     s : tStateIndex;
  185.     prod : tProduction;
  186.     read : Vocabulary;
  187.   BEGIN
  188.     (* Beschaffe neuen State *)
  189.  
  190.     NextState;
  191.  
  192.     (* Set fuer Closure initialisieren *)
  193.  
  194.     AssignEmpty (ProdSet);
  195.  
  196.     WITH StateArrayPtr^[Index] DO      (* State *)
  197.  
  198.       (* Fuer alle Items *)
  199.  
  200.       FOR i:=Items TO Items + Size - 1 DO
  201.  
  202.     (* Mit Symbol nach den Punkt *)
  203.  
  204.     IF (ItemArrayPtr^[i].Read = Symbol) THEN
  205.  
  206.       pr := ItemArrayPtr^[i].Prod;
  207.       po := ItemArrayPtr^[i].Pos;
  208.       p  := ADR(ProdArrayPtr^[pr]);
  209.  
  210.       (* erweitere den Zustand *)
  211.       IF (po+1 < p^.Len) THEN
  212.         read :=  p^.Right[po+2];
  213.       ELSE
  214.         read := MAXNonTerm + 1;
  215.       END;
  216.  
  217.       INC (StateArrayPtr^[StateIndex].Size);
  218.       NextItem (read);
  219.  
  220.       ItemArrayPtr^[ItemIndex].Prod := pr;
  221.       ItemArrayPtr^[ItemIndex].Pos    := po+1;
  222.  
  223.       IF (read >= MINNonTerm) AND (read <= MAXNonTerm) THEN
  224.         Closure (p^.Right[po+2]);
  225.       END;
  226.     END;
  227.       END;
  228.     END;              (* State *)
  229.  
  230.     s := UniqueState(new);
  231.  
  232.    (* Trage den berechneten State in Next ein *)
  233.  
  234.     WITH StateArrayPtr^[Index] DO      (* State *)
  235.  
  236.       (* Fuer alle Items *)
  237.  
  238.       FOR i:=Items TO Items + Size - 1 DO
  239.  
  240.       (* nach dem Punkt ist zu bearbeiten *)
  241.  
  242.     (* Mit Symbol nach den Punkt *)
  243.  
  244.     IF ItemArrayPtr^[i].Read = Symbol THEN
  245.       
  246.        (* Trage den Folgezustand ein *)
  247.  
  248.        ItemArrayPtr^[i].Next := s;
  249.     END;
  250.       END;
  251.     END;              (* State *)
  252.     RETURN s;
  253.   END Goto;
  254.  
  255. PROCEDURE Closure (Symbol: NonTerminal);
  256.   VAR
  257.     i,u : tIndex;
  258.     read : Vocabulary;
  259.     pr : tProdIndex;
  260.     po : tIndex;
  261.     exists : BOOLEAN;
  262.     p : tProduction;
  263.   BEGIN
  264.       WITH StateArrayPtr^[StateIndex] DO
  265.     WITH ProdList[Symbol] DO      (* Production *) 
  266.       u := Used;
  267.       FOR i := 1 TO u DO
  268.         
  269.         (* Fuege ein Item hinzu, falls dies noch nicht vorhanden *)
  270.  
  271.         pr := Array^[i].Index;
  272.         p := ADR (ProdArrayPtr^[pr]);
  273.  
  274.         IF NOT IsElement (p^.ProdNo, ProdSet) THEN
  275.           Include (ProdSet, p^.ProdNo);
  276.           INC(Size);
  277.  
  278.           (* read bestimmen *)
  279.  
  280.           WITH p^ DO
  281.         IF Len > 0 THEN
  282.           read := Right [1];
  283.         ELSE
  284.           read := MAXNonTerm + 1;
  285.         END;
  286.           END;
  287.  
  288.           NextItem (read);
  289.           WITH ItemArrayPtr^[ItemIndex] DO    (* Item *)
  290.         Prod := pr;
  291.         Pos  := 0;
  292.           END;            (* Item *)
  293.  
  294.           (* Falls Punkt vor Nichtterminal steht
  295.          ist dieser auch zu bearbeiten *)
  296.           
  297.           IF (read >= MINNonTerm) AND (read <= MAXNonTerm) THEN
  298.         Closure (read);
  299.           END;
  300.         END;
  301.       END;
  302.     END;           (* Production *)
  303.       END;         (* State *)
  304.   END Closure;
  305.  
  306. PROCEDURE UniqueState (VAR new: BOOLEAN): tStateIndex;
  307.   VAR
  308.     h: HashIndex;
  309.     i: LONGINT;
  310.   BEGIN
  311.     h := HashCode (StateIndex);
  312.     WITH StateHashList[h] DO
  313.       
  314.       (* Pruefe ob der State bereits vorhanden *)
  315.  
  316.       FOR i:=1 TO Used DO
  317.     IF AreEqualStates (StateIndex,Array^[i]) THEN
  318.       (* State ist bereits vorhanden *)
  319.  
  320.       (* Speicher freigeben *)
  321.  
  322.       (* Items freigeben *)
  323.       DEC (ItemIndex, StateArrayPtr^[StateIndex].Size);
  324.  
  325.       (* State freigeben *)
  326.       DEC (StateIndex);
  327.  
  328.       (* bereits bekannten State zurueckgeben *)
  329.  
  330.       new := FALSE;
  331.       RETURN Array^[i];
  332.     END;
  333.       END;
  334.  
  335.       (* neuen State in Hashtabelle eintragen *)
  336.  
  337.       IF Used = 0 THEN
  338.     Count := InitHashListCount;
  339.     MakeArray (Array,Count,TSIZE(tIndex));
  340.       ELSIF Used >= Count THEN
  341.     ExtendArray (Array,Count,TSIZE(tIndex));
  342.       END;
  343.       INC (Used);
  344.       Array^[Used] := StateIndex;
  345.       new := TRUE;
  346.       RETURN StateIndex;
  347.     END;
  348.   END UniqueState;
  349.   
  350. PROCEDURE InsertOperators;
  351.  
  352.   (* Einlesen des Abschnitts Oper, es werden steigende Prioritaeten zugeordnet *)
  353.  
  354.   VAR
  355.     o : tOper;
  356.     t : Vocabulary;
  357.     kn : OperKind;
  358.     ps,cmp : PosType;
  359.     cm : tList;
  360.   BEGIN
  361.     o.Pri := 0;
  362.     InitPrioReading;
  363.       WHILE GetPriority (kn,ps,cm,cmp) DO
  364.     IF kn = Left THEN
  365.       o.Ass := left;
  366.     ELSIF kn = Right THEN
  367.       o.Ass := right;
  368.     ELSE
  369.       o.Ass := nonassoc;
  370.     END;
  371.     INC (o.Pri);
  372.     WHILE GetOperator (t,ps) DO
  373.       OperArray [t] := o;
  374.     END;
  375.       END;
  376.   END InsertOperators;
  377.  
  378. PROCEDURE InsertProductions;
  379.  
  380.   (* Die Produktionen werden vom Module Rules eingelesen *)
  381.  
  382.   VAR
  383.     left  : NonTerminal;
  384.     lfp,clp,cmp,pnp,prp,prsp : PosType;
  385.     right : Expression;
  386.     cm      : tList;
  387.     hpr      : BOOLEAN;
  388.     prs      : Terminal;
  389.     act      : tList;
  390.     actpos: PosType;
  391.     voc      : Vocabulary;
  392.     index : tProdIndex;
  393.     maxIndex : tProdIndex;
  394.     value : SHORTCARD;
  395.     prod  : tProduction;
  396.     i      : SHORTCARD;
  397.   BEGIN
  398.  
  399.     (* Lese erste Regel *)
  400.  
  401.     InitRulesReading;
  402.     IF NOT GetRule (left,lfp,clp,right,cm, cmp,pnp,hpr,prp,prs,prsp) THEN
  403.       ERROR ('Automaton.InsertProduction');
  404.     END;
  405.  
  406.     (* Fuehre ein neues Startsymbol ein *)
  407.  
  408.     WITH Production^ DO
  409.       MakeList (Act);
  410.       ActPos := NoPosition;
  411.       Ass := none;
  412.       Pri := 0;
  413.       Len := 0;
  414.     END;
  415.     EnsureProdArray;
  416.     WITH Production^ DO
  417.       INC (Len);
  418.       Right[Len] := left;
  419.     END;
  420.     EnsureProdArray;
  421.     WITH Production^ DO
  422.       INC (Len);
  423.       Right[Len] := EndOfToken;
  424.     END;
  425.     StartSymbol := MakeNonTerm();
  426.     Production^.Left := StartSymbol;
  427.     NextProduction;
  428.  
  429.     (* Uebertrage die Regeln *)
  430.  
  431.     InitRulesReading;
  432.     WHILE GetRule (left,lfp,clp,right,cm,cmp,pnp,hpr,prp,prs,prsp) DO
  433.       WITH Production^ DO
  434.     MakeList (Act);
  435.     ActPos := NoPosition;
  436.     Ass := none;     (* Initialisierung auf keine Associativitaet *)
  437.     Pri := 0;     (* und minimale Prioritaet *)
  438.     Len := 0;
  439.       END;
  440.       InsertRight (right,TRUE);
  441.       WITH Production^ DO
  442.     Left := left;
  443.     prio := OperArray[prs].Pri;
  444.     IF hpr THEN
  445.       (* explizite Prioritaet geht vor *)
  446.       Pri := OperArray[prs].Pri;
  447.       Ass := OperArray[prs].Ass;
  448.     END;
  449.       END;
  450.       NextProduction;
  451.     END;
  452.  
  453.     (* Trage Regeln fuer innere semantische Ankopplungen nach *)
  454.  
  455.     WHILE PopAction (act,voc,actpos) DO
  456.       WITH Production^ DO
  457.     Act := act;
  458.     ActPos := actpos;
  459.     Pri := 0;
  460.     Ass := none;
  461.     Len := 0;
  462.     Left := voc;
  463.       END;
  464.       NextProduction;
  465.     END;
  466.  
  467.     ValueNonterms;
  468.  
  469.     maxIndex := ProdIndex;
  470.     index := 0;
  471.     WHILE index < maxIndex DO
  472.       prod := ADR(ProdArrayPtr^[index]);
  473.       value := 0;
  474.       WITH prod^ DO
  475.     FOR i := 1 TO Len DO
  476.       INC (value, Value[Right[i]]);
  477.     END;
  478.       END;
  479.       PutInProdList (index, value);
  480.       index := NextProdIndex(index);
  481.     END;
  482.   END InsertProductions;
  483.  
  484. PROCEDURE InsertRight (Expr: Expression; Last: BOOLEAN);
  485.   
  486.   (* Uebertrage einen Teilbaum in die rechte Seite der Regel 
  487.      wenn eine Konstruktion angetroffen wird die nicht BNF 
  488.      d.h., die nicht zulaessig ist wird eine Fehlermeldung ausgegeben
  489.      und IsBnf auf false gesetzt *)
  490.  
  491.   VAR
  492.     pos,secpos : PosType;
  493.     son,rson,lson : Expression;
  494.     art : Operation;
  495.     voc : Vocabulary;
  496.     act : tList;
  497.     sym : tIdent;
  498.     err : TokenError;
  499.   BEGIN
  500.     CASE GetNodeOperation(Expr) OF
  501.       Plus, Star :
  502.     IsBnf := FALSE;
  503.     GetUnaryNode (Expr,pos,son);
  504.     InsertRight (son,Last);
  505.     ErrorMessage (eNoBNF,eError,pos);
  506.     |  Bracket :
  507.     GetBracketNode (Expr,pos,secpos,son);
  508.     ErrorMessage (eNoBNF,eWarning,pos);
  509.     InsertRight (son,Last);
  510.     | Optional :
  511.     IsBnf := FALSE;
  512.     GetBracketNode (Expr,pos,secpos,son);
  513.     ErrorMessage (eNoBNF,eError,pos);
  514.     | Sequence :
  515.     GetBinaryNode (Expr,pos,lson,rson);
  516.     IF rson = NoExpression THEN
  517.       InsertRight (lson,Last);
  518.     ELSE
  519.       InsertRight (lson,FALSE);
  520.     END;
  521.     InsertRight (rson,Last);
  522.     | Separator, Alternative:
  523.     IsBnf := FALSE;
  524.     GetBinaryNode (Expr,pos,lson,rson);
  525.     InsertRight (lson,FALSE);
  526.     ErrorMessage (eNoBNF,eError,pos);
  527.     InsertRight (rson,FALSE);
  528.     | TermLeaf:
  529.     IF IsBnf THEN
  530.       EnsureProdArray;
  531.       GetLeafNode (Expr,voc,pos);
  532.       WITH Production^ DO
  533.         INC (Len);
  534.         Right[Len] := voc;
  535.         IF OperArray [voc].Ass # none THEN
  536.           (* der letzte Operator innerhalb der Regel gilt *)
  537.           Ass := OperArray[voc].Ass;
  538.           Pri := OperArray[voc].Pri;
  539.         END;
  540.       END;
  541.     END;
  542.     | NonTermLeaf:
  543.     IF IsBnf THEN
  544.       EnsureProdArray;
  545.       GetLeafNode (Expr,voc,pos);
  546.       WITH Production^ DO
  547.         INC (Len);
  548.         Right[Len] := voc;
  549.       END;
  550.     END;
  551.     | Action:
  552.     IF IsBnf THEN
  553.       GetActionNode (Expr,act,pos);
  554.       IF Last THEN
  555.         Production^.Act := act;
  556.         Production^.ActPos := pos;
  557.       ELSE
  558.         EnsureProdArray;
  559.         voc := MakeNonTerm ();
  560.         sym := TokenToSymbol (voc,err);
  561.         ErrorMessageI (eActInside, eInformation, pos, eIdent, ADR (sym));
  562.         WITH Production^ DO
  563.           INC (Len);
  564.           Right[Len] := voc;
  565.         END;
  566.         PushAction (act,voc,pos);
  567.       END;
  568.     END;
  569.     | NoOperation:
  570.     END;
  571.   END InsertRight;
  572.  
  573. PROCEDURE PutInProdList (index: tProdIndex; value: SHORTCARD);
  574.  
  575.   (* Die angegebene  Produktion wird gem. ihrer linken Seite in die
  576.      zugh. ProdList sortiert eingetragen *)
  577.   
  578.   VAR
  579.     prod : tProduction;
  580.     i     : tIndex;
  581.   BEGIN
  582.     prod := ADR (ProdArrayPtr^[index]);
  583.     WITH ProdList[prod^.Left] DO
  584.       IF Used = 0 THEN
  585.     Count := InitListCount;
  586.     MakeArray (Array,Count,TSIZE(tProdListElmt));
  587.     INC (Used);
  588.     Array^[Used].Index := index; 
  589.     Array^[Used].Value := value; 
  590.       ELSE
  591.     IF Used >= Count THEN
  592.       ExtendArray (Array,Count,TSIZE(tProdListElmt));
  593.     END;
  594.     (* laengere Produktionen nach hinten verschieben *)
  595.     i := Used;
  596.     WHILE (i > 0) AND (Array^[i].Value > value) DO
  597.       Array^[i+1].Index := Array^[i].Index;
  598.       Array^[i+1].Value := Array^[i].Value;
  599.       DEC (i);
  600.     END;
  601.     INC (i);
  602.     (* neue Produktion eintragen *)
  603.     Array^[i].Index := index;
  604.     Array^[i].Value := value;
  605.     INC (Used);
  606.       END;
  607.     END;
  608.   END PutInProdList;
  609.  
  610. PROCEDURE NextProduction;
  611.  
  612.   (* Schalte die aktuelle Produktion weiter *)
  613.   (* wie immer nach dem ausfuellen einer Produktion aufgerufen *)
  614.  
  615.   BEGIN
  616.     INC (ProdCount);
  617.     WITH Production^ DO
  618.       ProdNo := ProdCount;
  619.       Reduce.Used := 0;
  620.     END;
  621.     ProdIndex := NextProdIndex(ProdIndex);
  622.     IF (ProdIndex + (TSIZE(tDummyProduction) + MaxAlign - 1) DIV MaxAlign * MaxAlign) >= ProdElmtCount THEN
  623.       ExtendArray (ProdArrayPtr, ProdElmtCount, TSIZE(WORD));
  624.     END;
  625.     Production := ADR(ProdArrayPtr^[ProdIndex]);
  626.   END NextProduction;
  627.  
  628. PROCEDURE NextProdIndex (Index: tProdIndex): tProdIndex;
  629.   VAR 
  630.     diff : CARDINAL;
  631.     prod : tProduction;
  632.   BEGIN
  633.     prod := ADR (ProdArrayPtr^[Index]);
  634.         (* Platzbedarf fuer konstantlangen Teil *)
  635.     diff := CARDINAL ((TSIZE(tDummyProduction) + MaxAlign - 1) DIV MaxAlign * MaxAlign)
  636.           (* Platzbedarf fuer variabellangen Teil *)
  637.         + ((prod^.Len+3) DIV 4) * TSIZE(tDummyRight4);
  638.     RETURN Index + (diff-1) DIV TSIZE (WORD) + 1;
  639.   END NextProdIndex;
  640.  
  641. PROCEDURE EnsureProdArray;
  642.  
  643.   (* stelle sicher, dass in die rechte Seite der Produktion noch um
  644.      mindestes eins verlaengert werden kann *)
  645.  
  646.   VAR diff : LONGINT;
  647.   BEGIN
  648.         (* Platzbedarf fuer konstantlangen Teil *)
  649.     diff := CARDINAL ((TSIZE(tDummyProduction) + MaxAlign - 1) DIV MaxAlign * MaxAlign)
  650.           (* Platzbedarf fuer variabellangen Teil *)
  651.         + (((Production^.Len+1)+3) DIV 4) * TSIZE(tDummyRight4);
  652.     IF (ProdIndex + (diff-1) DIV TSIZE(WORD) + 1) >= ProdElmtCount THEN
  653.       ExtendArray (ProdArrayPtr, ProdElmtCount, TSIZE(WORD));
  654.       Production := ADR(ProdArrayPtr^[ProdIndex]);
  655.     END;
  656.   END EnsureProdArray;
  657.  
  658. PROCEDURE NextItem (ReadSym: Vocabulary); (* Beschaffe das naechste Item *)
  659.   BEGIN
  660.     INC (ItemIndex);
  661.     IF ItemIndex > ItemElmtCount THEN
  662.       ExtendArray (ItemArrayPtr, ItemElmtCount, TSIZE(tItem));
  663.       IF ItemArrayPtr = NIL THEN HALT; END;
  664.     END;
  665.     WITH ItemArrayPtr^[ItemIndex] DO
  666.       EmptyReadSet := TRUE;
  667.       Relation.Used := 0;
  668.       Relation.Count := InitRelationListCount;
  669.       Read := ReadSym;
  670.       Rep := NoRep;
  671.       RepNo := Infinite;
  672.       Next := Infinite;
  673.       Number := 0;
  674.     END;
  675.   END NextItem;
  676.       
  677. PROCEDURE NextState ();
  678.  
  679.   (* Beschaffe den naechsten State und initialisiere ihn mit
  680.      dem naechsten (aktuellen+1) Item *)
  681.  
  682.   BEGIN
  683.     INC (StateIndex);
  684.     IF StateIndex > StateElmtCount THEN
  685.       ExtendArray (StateArrayPtr, StateElmtCount, TSIZE(tState));
  686.     END;
  687.     WITH StateArrayPtr^[StateIndex] DO
  688.       Size := 0;
  689.       Items := ItemIndex+1;
  690.       NewNumber := Infinite;
  691.       Kind := sNone;
  692.     END;
  693.   END NextState;
  694.   
  695. PROCEDURE MakeNonTerm (): NonTerminal; (* Erzeuge ein neues Nichtterminal *)
  696.   VAR
  697.     s : tString;
  698.     max,i,j : CARDINAL;
  699.     pos : PosType;
  700.     voc : Vocabulary;
  701.   BEGIN
  702.     s.Chars[1] := '_';
  703.     s.Length := 6;
  704.     max := MAXNonTerm;
  705.     REPEAT
  706.       i := NonTermNo;
  707.       FOR j:=5 TO 2 BY -1 DO
  708.     s.Chars[j]:=CHR(ORD('0')+(i MOD 10));
  709.     i := i DIV 10;
  710.       END;
  711.       s.Chars[6] := '_';
  712.       pos := NoPosition;
  713.       INC(NonTermNo);
  714.       voc := MakeVoc (MakeIdent (s),pos);
  715.     UNTIL max < MAXNonTerm;
  716.     RETURN voc;
  717.   END MakeNonTerm;
  718.  
  719. PROCEDURE AreEqualStates (Index1, Index2: tStateIndex): BOOLEAN;
  720.   VAR
  721.     i1,i2 : tItemIndex;
  722.     l1,l2 : tItemIndex;
  723.   BEGIN
  724.     i1 := StateArrayPtr^[Index1].Items;
  725.     i2 := StateArrayPtr^[Index2].Items;
  726.     l1 := StateArrayPtr^[Index1].Size;
  727.     l2 := StateArrayPtr^[Index2].Size;
  728.     IF l1 # l2 THEN RETURN FALSE END;
  729.     INC (l1,i1);
  730.     INC (l2,i2);
  731.     WHILE (i1 < l1) AND (i2 < l2) DO
  732.       IF ItemArrayPtr^[i1].Prod # ItemArrayPtr^[i2].Prod THEN RETURN FALSE; END;
  733.       IF ItemArrayPtr^[i1].Pos    # ItemArrayPtr^[i2].Pos     THEN RETURN FALSE; END;
  734.       INC (i1);
  735.       INC (i2);
  736.     END;
  737.     IF    (i1 < l1) THEN RETURN ItemArrayPtr^[i1].Pos = 0;
  738.     ELSIF (i2 < l2) THEN RETURN ItemArrayPtr^[i2].Pos = 0;
  739.     ELSE RETURN TRUE;
  740.     END;
  741.   END AreEqualStates;
  742.  
  743. PROCEDURE HashCode (Index: tStateIndex): HashIndex;
  744.   BEGIN
  745.     WITH ItemArrayPtr^[StateArrayPtr^[Index].Items] DO
  746.       RETURN (Prod+Pos) MOD (MAX(HashIndex)-MIN(HashIndex)+1) + MIN(HashIndex);
  747.     END;
  748.   END HashCode;
  749.       
  750. PROCEDURE PushAction (act: tList; voc: Vocabulary; actpos: PosType);
  751.   BEGIN
  752.     INC (StackIndex);
  753.     IF StackElmtCount = 0 THEN
  754.       StackElmtCount := InitStackCount;
  755.       MakeArray (StackArrayPtr,StackElmtCount,TSIZE(tStackElmt));
  756.     ELSIF StackIndex > StackElmtCount THEN
  757.       ExtendArray (StackArrayPtr,StackElmtCount,TSIZE(tStackElmt));
  758.     END;
  759.     StackArrayPtr^[StackIndex].Act := act;
  760.     StackArrayPtr^[StackIndex].ActPos := actpos;
  761.     StackArrayPtr^[StackIndex].Voc := voc;
  762.   END PushAction;
  763.  
  764. PROCEDURE PopAction (VAR act: tList; VAR voc: Vocabulary; VAR actpos: PosType): BOOLEAN;
  765.   BEGIN
  766.     IF StackIndex < 1 THEN RETURN FALSE; END;
  767.     act := StackArrayPtr^[StackIndex].Act;
  768.     actpos := StackArrayPtr^[StackIndex].ActPos;
  769.     voc := StackArrayPtr^[StackIndex].Voc;
  770.     DEC (StackIndex);
  771.     RETURN TRUE;
  772.   END PopAction;
  773.  
  774. PROCEDURE ERROR (a: ARRAY OF CHAR);
  775.   VAR s: tString;
  776.   BEGIN
  777.     ArrayToString (a, s);
  778.     ErrorMessageI (eInternal, eFatal, NoPosition, eString, ADR (s));
  779.   END ERROR;
  780.  
  781. BEGIN
  782.   ProdElmtCount := InitProdCount;
  783.   MakeArray (ProdArrayPtr, ProdElmtCount, TSIZE(WORD));
  784.  
  785.   ItemElmtCount := InitItemCount;
  786.   MakeArray (ItemArrayPtr, ItemElmtCount, TSIZE(tItem));
  787.  
  788.   StateElmtCount := InitStateCount;
  789.   MakeArray (StateArrayPtr, StateElmtCount, TSIZE(tState));
  790.  
  791.   FOR i := MIN(NonTerminal) TO MAX(NonTerminal) DO
  792.     ProdList[i].Used := 0;
  793.   END;
  794.  
  795.   FOR i := MIN(HashIndex) TO MAX(HashIndex) DO
  796.     StateHashList[i].Used := 0;
  797.   END;
  798.  
  799.   FOR i:= MIN(Terminal) TO MAX (Terminal) DO
  800.     WITH OperArray[i] DO
  801.       Ass := none;
  802.       Pri := 0;
  803.     END;
  804.   END;
  805.  
  806.   ProdCount := 0;
  807.   ProdIndex := 0;
  808.   Production := ADR(ProdArrayPtr^[ProdIndex]);
  809.   ItemIndex := 0;
  810.   StateIndex := 0;
  811.   StackElmtCount := 0;
  812.   StackIndex := 0;
  813. END Automaton.
  814.